home *** CD-ROM | disk | FTP | other *** search
Text File | 1989-11-03 | 46.4 KB | 1,148 lines |
- Newsgroups: comp.sources.misc
- subject: v08i113: pcmail part 05 of 08
- From: allbery@uunet.UU.NET (Brandon S. Allbery - comp.sources.misc)
- Reply-To: markl@oracle.com (Croaker the Physician)
-
- Posting-number: Volume 8, Issue 113
- Submitted-by: markl@oracle.com (Croaker the Physician)
- Archive-name: pcmail/part05
-
- #--------------------------------CUT HERE-------------------------------------
- #! /bin/sh
- #
- # This is a shell archive. Save this into a file, edit it
- # and delete all lines above this comment. Then give this
- # file to sh by executing the command "sh file". The files
- # will be extracted into the current directory owned by
- # you with default permissions.
- #
- # The files contained herein are:
- #
- # -rw-rw-r-- 1 markl 4075 Oct 31 11:53 pcmailedit.el
- # -rw-rw-r-- 1 markl 30814 Oct 31 11:50 pcmailfolder.el
- # -rw-rw-r-- 1 markl 9542 Oct 30 16:01 pcmaillist.el
- #
- echo 'x - pcmailedit.el'
- if test -f pcmailedit.el; then echo 'shar: not overwriting pcmailedit.el'; else
- sed 's/^X//' << '________This_Is_The_END________' > pcmailedit.el
- X;;;; GNU-EMACS PCMAIL mail reader
- X
- X;; Written by Mark L. Lambert
- X;; Architecture Group, Network Products Division
- X;; Oracle Corporation
- X;; 20 Davis Dr,
- X;; Belmont CA, 94002
- X;;
- X;; internet: markl@oracle.com or markl%oracle.com@apple.com
- X;; UUCP: {hplabs,uunet,apple}!oracle!markl
- X
- X;; Copyright (C) 1989 Mark L. Lambert
- X
- X;; This file is not officially part of GNU Emacs, but is being
- X;; donated to the Free Software Foundation. As such, it is
- X;; subject to the standard GNU-Emacs General Public License,
- X;; referred to below.
- X
- X;; GNU Emacs is distributed in the hope that it will be useful,
- X;; but WITHOUT ANY WARRANTY. No author or distributor
- X;; accepts responsibility to anyone for the consequences of using it
- X;; or for whether it serves any particular purpose or works at all,
- X;; unless he says so in writing. Refer to the GNU Emacs General Public
- X;; License for full details.
- X
- X;; Everyone is granted permission to copy, modify and redistribute
- X;; GNU Emacs, but only under the conditions described in the
- X;; GNU Emacs General Public License. A copy of this license is
- X;; supposed to have been given to you along with GNU Emacs so you
- X;; can know your rights and responsibilities. It should be in a
- X;; file named COPYING. Among other things, the copyright notice
- X;; and this notice must be preserved on all copies.
- X
- X;;; edit a mail message. Substantially similar to rmailedit.el
- X
- X(defvar pcmail-edit-mode-map nil)
- X(if pcmail-edit-mode-map
- X nil
- X (setq pcmail-edit-mode-map (copy-keymap text-mode-map))
- X (define-key pcmail-edit-mode-map "\C-c\C-c" 'pcmail-cease-edit)
- X (define-key pcmail-edit-mode-map "\C-c\C-]" 'pcmail-abort-edit))
- X
- X(defun pcmail-edit-mode ()
- X "Pcmail Edit Mode is used when editing Pcmail messages.
- XPcmail Edit mode is identical to text mode with the addition of two commands:
- X\\[pcmail-cease-edit], which saves an edit, and
- X\\[pcmail-abort-edit], which aborts an edit."
- X (put 'pcmail-edit-mode 'mode-class 'special)
- X (use-local-map pcmail-edit-mode-map)
- X (setq major-mode 'pcmail-edit-mode
- X mode-name "Edit")
- X (make-local-variable 'pcmail-old-text)
- X (run-hooks 'pcmail-edit-mode-hook))
- X
- X(defun pcmail-edit-message ()
- X "Edit the contents of the current message.
- XArgs: none
- X Allow the body of the current message to be edited. On save, changes
- Xare made permanent. On abort, old body is restored. Type
- X\\[pcmail-cease-edit\\] to make changes permanent, \\[pcmail-abort-edit\\] to
- Xabort changes."
- X (interactive)
- X (pcmail-barf-if-empty-folder)
- X (pcmail-edit-mode)
- X
- X ;; keep header out of edit region -- stupid lusers could screw it up
- X (goto-char (point-min))
- X (and (search-forward pcmail-header-delim nil t)
- X (narrow-to-region (point) (point-max)))
- X (setq pcmail-old-text (buffer-substring (point-min) (point-max)))
- X (setq buffer-read-only nil)
- X (pcmail-update-folder-mode-line pcmail-current-subset-message)
- X (message (substitute-command-keys
- X (concat "Message edit: Type \\[pcmail-cease-edit] "
- X "to save changes, \\[pcmail-abort-edit] to abort"))))
- X
- X(defun pcmail-cease-edit ()
- X "Make changes to current message permanent. Switch back to pcmail keymap.
- XArgs: none"
- X (interactive)
- X (unwind-protect
- X (cond ((and (= (length pcmail-old-text) (- (point-max) (point-min)))
- X (string= pcmail-old-text
- X (buffer-substring (point-min) (point-max))))
- X (message "Edit complete; no changes"))
- X (t
- X (pcmail-set-attribute
- X (pcmail-make-absolute pcmail-current-subset-message) "edited" t)
- X (message "Edit complete.")))
- X
- X ;; note -- cannot call pcmail-folder-mode because it gronks all local
- X ;; variables. That would be Bad.
- X (use-local-map pcmail-folder-mode-map)
- X (setq major-mode 'pcmail-folder-mode
- X mode-name "Folder")
- X (pcmail-goto-message pcmail-current-subset-message)
- X (setq buffer-read-only t)))
- X
- X(defun pcmail-abort-edit ()
- X "Abort edit of current message; restore original message body.
- XArgs: none"
- X (interactive)
- X (delete-region (point-min) (point-max))
- X (insert pcmail-old-text)
- X (pcmail-cease-edit))
- X
- X(provide 'pcmailedit)
- ________This_Is_The_END________
- if test `wc -c < pcmailedit.el` -ne 4075; then
- echo 'shar: pcmailedit.el was damaged during transit (should have been 4075 bytes)'
- fi
- fi ; : end of overwriting check
- echo 'x - pcmailfolder.el'
- if test -f pcmailfolder.el; then echo 'shar: not overwriting pcmailfolder.el'; else
- sed 's/^X//' << '________This_Is_The_END________' > pcmailfolder.el
- X;;;; GNU-EMACS PCMAIL mail reader
- X
- X;; Written by Mark L. Lambert
- X;; Architecture Group, Network Products Division
- X;; Oracle Corporation
- X;; 20 Davis Dr,
- X;; Belmont CA, 94002
- X;;
- X;; internet: markl@oracle.com or markl%oracle.com@apple.com
- X;; UUCP: {hplabs,uunet,apple}!oracle!markl
- X
- X;; Copyright (C) 1989 Mark L. Lambert
- X
- X;; This file is not officially part of GNU Emacs, but is being
- X;; donated to the Free Software Foundation. As such, it is
- X;; subject to the standard GNU-Emacs General Public License,
- X;; referred to below.
- X
- X;; GNU Emacs is distributed in the hope that it will be useful,
- X;; but WITHOUT ANY WARRANTY. No author or distributor
- X;; accepts responsibility to anyone for the consequences of using it
- X;; or for whether it serves any particular purpose or works at all,
- X;; unless he says so in writing. Refer to the GNU Emacs General Public
- X;; License for full details.
- X
- X;; Everyone is granted permission to copy, modify and redistribute
- X;; GNU Emacs, but only under the conditions described in the
- X;; GNU Emacs General Public License. A copy of this license is
- X;; supposed to have been given to you along with GNU Emacs so you
- X;; can know your rights and responsibilities. It should be in a
- X;; file named COPYING. Among other things, the copyright notice
- X;; and this notice must be preserved on all copies.
- X
- X;;;; folder commands and utilities
- X
- X;;;; global variables
- X
- X;;; system-defined globals
- X
- X(defconst pcmail-folder-regexp
- X (get 'pcmail-mail-environment 'legal-folder-regexp)
- X "Regexp describing a legal folder name.")
- X
- X(defconst pcmail-folder-line-regexp
- X (concat "Folder[ \t]+\\(" pcmail-folder-regexp "\\):[ \t]*\\([0-9]+\\)")
- X "Regexp that finds a folder entry in the folder list buffer and binds its
- Xname to \\1 and its message count to \\2.")
- X
- X(defvar pcmail-folder-mode-map nil
- X "Key map for pcmail mode.")
- X
- X;;; defaults
- X
- X(defvar pcmail-last-folder nil
- X "The last folder name given to a folder command.")
- X
- X;;;; folder mode definition
- X
- X(if pcmail-folder-mode-map
- X nil
- X (suppress-keymap (setq pcmail-folder-mode-map (make-keymap)))
- X (define-key pcmail-folder-mode-map "?" 'describe-mode)
- X (define-key pcmail-folder-mode-map "." 'pcmail-beginning-of-message)
- X (define-key pcmail-folder-mode-map " " 'scroll-up)
- X (define-key pcmail-folder-mode-map ">" 'pcmail-last-message)
- X (define-key pcmail-folder-mode-map "<" 'pcmail-goto-message)
- X (define-key pcmail-folder-mode-map "a" 'pcmail-archive-message)
- X (define-key pcmail-folder-mode-map "b" 'pcmail-sort-folder)
- X (define-key pcmail-folder-mode-map "c" 'pcmail-copy-message)
- X (define-key pcmail-folder-mode-map "d" 'pcmail-delete-message)
- X (define-key pcmail-folder-mode-map "e" 'pcmail-expunge-folder)
- X (define-key pcmail-folder-mode-map "f" 'pcmail-forward-message)
- X (define-key pcmail-folder-mode-map "g" 'pcmail-get-mail)
- X (define-key pcmail-folder-mode-map "h" 'pcmail-summarize-folder)
- X (define-key pcmail-folder-mode-map "i" 'pcmail-change-message-priority)
- X (define-key pcmail-folder-mode-map "j" 'pcmail-goto-message)
- X (define-key pcmail-folder-mode-map "k" 'pcmail-kill-message-later)
- X (define-key pcmail-folder-mode-map "l" 'pcmail-load-mail-drop)
- X (define-key pcmail-folder-mode-map "m" 'pcmail-mail)
- X (define-key pcmail-folder-mode-map "n" 'pcmail-next-message)
- X (define-key pcmail-folder-mode-map "o" 'pcmail-print-message)
- X (define-key pcmail-folder-mode-map "p" 'pcmail-previous-message)
- X (define-key pcmail-folder-mode-map "q" 'pcmail-quit)
- X (define-key pcmail-folder-mode-map "r" 'pcmail-answer-message)
- X (define-key pcmail-folder-mode-map "s" 'pcmail-save-folder)
- X (define-key pcmail-folder-mode-map "t" 'pcmail-toggle-message-header)
- X (define-key pcmail-folder-mode-map "u" 'pcmail-undelete-previous-message)
- X (define-key pcmail-folder-mode-map "v" 'pcmail-version-information)
- X (define-key pcmail-folder-mode-map "w" 'pcmail-edit-message)
- X (define-key pcmail-folder-mode-map "x" 'pcmail-expand-subset)
- X (define-key pcmail-folder-mode-map "y" 'pcmail-change-message-attr)
- X (define-key pcmail-folder-mode-map "z" 'pcmail-zap-to-message)
- X (define-key pcmail-folder-mode-map "\C-d" 'pcmail-delete-message-backward)
- X (define-key pcmail-folder-mode-map "\C-m" 'pcmail-next-message)
- X (define-key pcmail-folder-mode-map "\C-xm" 'pcmail-mail)
- X (define-key pcmail-folder-mode-map "\177" 'scroll-down)
- X (define-key pcmail-folder-mode-map "\ec" 'pcmail-create-folder)
- X (define-key pcmail-folder-mode-map "\ed" 'pcmail-delete-folder)
- X (define-key pcmail-folder-mode-map "\em" 'pcmail-folder-list-folders)
- X (define-key pcmail-folder-mode-map "\en" 'pcmail-next-message-of-type)
- X (define-key pcmail-folder-mode-map "\ep" 'pcmail-previous-message-of-type)
- X (define-key pcmail-folder-mode-map "\er" 'pcmail-rename-folder)
- X (define-key pcmail-folder-mode-map "\e\C-a" 'pcmail-archive-subset)
- X (define-key pcmail-folder-mode-map "\e\C-c" 'pcmail-copy-subset)
- X (define-key pcmail-folder-mode-map "\e\C-d" 'pcmail-delete-subset)
- X (define-key pcmail-folder-mode-map "\e\C-f" 'pcmail-filter-folder)
- X (define-key pcmail-folder-mode-map "\e\C-i" 'pcmail-change-priority-subset)
- X (define-key pcmail-folder-mode-map "\e\C-n" 'pcmail-get-next-folder-mail)
- X (define-key pcmail-folder-mode-map "\e\C-o" 'pcmail-print-subset)
- X (define-key pcmail-folder-mode-map "\e\C-u" 'pcmail-undelete-subset)
- X (define-key pcmail-folder-mode-map "\e\C-y" 'pcmail-change-attr-subset))
- X
- X;;; pcmail-folder mode -- used in folders
- X
- X(defun pcmail-folder-mode ()
- X "Pcmail Folder Mode is used by \\[pcmail] for examining mail messages.
- XThe following commands are available:
- X
- X\\{pcmail-folder-mode-map}"
- X (pcmail-mode-setup 'pcmail-folder-mode "Folder" pcmail-folder-mode-map)
- X (pcmail-make-folder-local-variables)
- X (setq mode-line-format
- X (list "" 'pcmail-display-info " " 'global-mode-string))
- X (run-hooks 'pcmail-folder-mode-hook))
- X
- X(defun pcmail-make-folder-local-variables ()
- X "Create and initialize per-folder local variables.
- XArgs: none."
- X (make-local-variable 'pcmail-total-messages)
- X (make-local-variable 'pcmail-current-subset-message)
- X (make-local-variable 'pcmail-message-vector)
- X (make-local-variable 'pcmail-current-subset-vector)
- X (make-local-variable 'pcmail-attr-vector)
- X (make-local-variable 'pcmail-summary-vector)
- X (make-local-variable 'pcmail-date-vector)
- X (make-local-variable 'pcmail-priority-vector)
- X (make-local-variable 'pcmail-current-filter-description)
- X (make-local-variable 'pcmail-display-info)
- X (make-local-variable 'pcmail-summary-buffer)
- X (make-local-variable 'pcmail-folder-name)
- X (setq pcmail-total-messages nil
- X pcmail-current-subset-message nil
- X pcmail-message-vector nil
- X pcmail-current-subset-vector nil
- X pcmail-attr-vector nil
- X pcmail-summary-vector nil
- X pcmail-date-vector nil
- X pcmail-priority-vector nil
- X pcmail-current-filter-description t
- X pcmail-display-info nil
- X pcmail-summary-buffer nil
- X pcmail-folder-name nil))
- X
- X;;;; folder operations and associated utility routines
- X
- X(defun pcmail-create-folder (folder-name &optional mail-drop-list)
- X "Create a new folder and maybe attach a mail drop to it.
- XArgs: (folder-name &optional mail-drop-list)
- X If called as a function, supply a folder name and an optional list of
- Xmail drop symbols; if called interactively, read the folder name from the
- Xminibuffer and read a single mail drop symbol if a prefix argument was
- Xsupplied, turning the symbol into a list of length 1 containing the symbol.
- XThe folder created will have a mail: field containing the mail drop symbol
- Xor symbols; mail will be transferred from these mail drops when the
- X\\[pcmail-get-mail] command is issued."
- X (interactive
- X (list (pcmail-read-folder "Create folder named: ")
- X (and current-prefix-arg
- X (list (intern-soft
- X (pcmail-completing-read "Attach mail drop of type: "
- X obarray pcmail-last-mail-drop-type
- X '(lambda (s)
- X (get s 'insert-function))
- X t))))))
- X (and (pcmail-find-folder folder-name)
- X (error "A folder named %s already exists." folder-name))
- X (message "Creating %s..." folder-name)
- X (pcmail-insert-into-folder-list folder-name 0)
- X (pcmail-create-folder-file folder-name mail-drop-list)
- X (message "Creating %s...done" folder-name))
- X
- X(defun pcmail-delete-folder (&optional folder-name)
- X "Delete a specified folder.
- XArgs: (folder-name)
- X If called interactively with a prefix argument, read a folder name from
- Xthe minibuffer and delete that folder, otherwise delete the current folder.
- XIf called as a function, supply a folder name or NIL to delete the current
- Xfolder. Delete FOLDER-NAME, provided it is not pcmail-primary-folder-name.
- XDelete the folder file, remove its entry in the folder info list, remove
- Xits line in the folder list file, kill its message buffer, and kill its
- Xsummary buffer. If FOLDER-NAME has an attached mail drop, get that
- Xmail drop's folder-delete-hook property and run the hook."
- X (interactive
- X (list (and current-prefix-arg (pcmail-read-folder "Delete folder: "))))
- X (or folder-name
- X (setq folder-name pcmail-folder-name))
- X (and (string= folder-name pcmail-primary-folder-name)
- X (error "You may not delete your primary folder."))
- X (or (pcmail-find-folder folder-name)
- X (error "No folder named %s." folder-name))
- X (or (yes-or-no-p "Deletion is permanent; are you sure? ")
- X (error "Delete aborted."))
- X (message "Deleting %s..." folder-name)
- X (pcmail-open-folder folder-name)
- X (let ((droplist (pcmail-get-mail-drop-list folder-name))
- X (drop-delete))
- X (and droplist
- X (while droplist
- X (and (setq drop-delete (get (car droplist) 'folder-delete-hook))
- X (funcall drop-delete folder-name))
- X (setq droplist (cdr droplist)))))
- X (pcmail-remove-from-folder-list folder-name)
- X (pcmail-delete-folder-file folder-name)
- X (message "Deleting %s...done" folder-name))
- X
- X(defun pcmail-rename-folder (from to)
- X "Change the name of the current folder.
- XArgs: (from to)
- X Rename buffer, folder file, and summary buffer. Update folder list buffer
- Xto reflect new name. If called interactively, request new name. With prefix
- Xargument, request name of folder to rename, otherwise rename current folder.
- XIf called as a function, supply folder to be renamed, NIL for current
- Xfolder, together with its new name. You may not rename
- Xpcmail-primary-folder-name"
- X (interactive
- X (list (and current-prefix-arg (pcmail-read-folder "Rename folder: "))
- X (pcmail-read-folder "Rename to new name: ")))
- X (or from
- X (setq from pcmail-folder-name))
- X (and (string= from pcmail-primary-folder-name)
- X (error "You may not rename your primary folder."))
- X (or (pcmail-find-folder from)
- X (error "No folder named %s." from))
- X (and (pcmail-find-folder to)
- X (error "A folder named %s already exists." to))
- X (message "Renaming %s to %s..." from to)
- X (save-excursion
- X (pcmail-open-folder from)
- X ; make target buffer, write new file to disk, delete old, rename buffer
- X (let ((tobuf to))
- X (and (get-buffer tobuf)
- X (let ((count 1))
- X (while (get-buffer (setq tobuf (format "%s<%d>" to count)))
- X (setq count (1+ count)))))
- X (write-file (pcmail-folder-file-name to))
- X (condition-case nil
- X (delete-file (pcmail-folder-file-name from))
- X (file-error nil))
- X (setq pcmail-folder-name to)
- X (pcmail-add-folder-entry to (pcmail-nmessages from) tobuf
- X (pcmail-mail-drop-list from))
- X (pcmail-remove-folder-entry from)
- X (pcmail-update-folder-mode-line pcmail-current-subset-message))
- X ; generate target summary buffer and rename to it
- X (and pcmail-summary-buffer
- X (buffer-name pcmail-summary-buffer)
- X (let ((tobuf (concat to "-summary"))
- X (owner-name pcmail-folder-name))
- X (and (get-buffer tobuf)
- X (let ((count 1))
- X (while (get-buffer (setq tobuf (format "%s<%d>" to count)))
- X (setq count (1+ count)))))
- X (save-excursion
- X (set-buffer pcmail-summary-buffer)
- X (rename-buffer tobuf)
- X (setq pcmail-summary-owner to)
- X (pcmail-set-summary-mode-line-format owner-name))
- X (setq pcmail-summary-buffer (get-buffer tobuf))))
- X ; update folder list buffer
- X (pcmail-insert-into-folder-list to (pcmail-nmessages to))
- X (pcmail-remove-from-folder-list from))
- X (message "Renaming %s to %s...done" from to))
- X
- X(defun pcmail-save-folder (&optional folder)
- X "Save a folder buffer to disk.
- XArgs: (&optional folder)
- X If called interactively, a prefix argument means ask for the name of a
- Xfolder to save, otherwise save the current folder. If called as a function,
- Xsupply the name of the folder to save, or NIL to save the current folder.
- XIf pcmail-expunge-on-save is non-nil, expunge the folder before saving."
- X (interactive
- X (list (and current-prefix-arg (pcmail-read-folder "Save folder: "))))
- X (or folder
- X (setq folder pcmail-folder-name))
- X (or (pcmail-find-folder folder)
- X (error "No folder named %s." folder))
- X (and pcmail-expunge-on-save
- X (pcmail-expunge-folder folder))
- X (message "Saving %s..." folder)
- X (pcmail-open-folder folder)
- X (pcmail-save-buffer)
- X (message "Saving %s...done" folder))
- X
- X(defun pcmail-expunge-folder (&optional folder)
- X "Expunge all deleted messages in a specified folder.
- XArgs: (&optional folder)
- X If called interactively, a prefix argument means ask for the name of a
- Xfolder to expunge, otherwise expunge the current folder. If called as
- Xa function, supply the name of the folder to expunge, or NIL to expunge
- Xthe current folder."
- X (interactive
- X (list (and current-prefix-arg (pcmail-read-folder "Expunge folder: "))))
- X (or folder
- X (setq folder pcmail-folder-name))
- X (or (pcmail-find-folder folder)
- X (error "No folder named %s." folder))
- X (message "Expunging %s..." folder)
- X (pcmail-open-folder folder)
- X (let* ((current-message 1)
- X (new-messages (list (aref pcmail-message-vector 0)))
- X (new-summary (list nil))
- X (new-date (list nil))
- X (new-priority (list nil))
- X (new-subset-map (make-vector (1+ pcmail-total-messages) 0))
- X (new-attr (list nil))
- X (new-current pcmail-current-subset-message)
- X (ndeleted-messages 0)
- X (buffer-read-only nil))
- X (unwind-protect
- X (save-restriction
- X (widen)
- X (goto-char (point-min))
- X (pcmail-expunge-loop)
- X (setq pcmail-total-messages
- X (- pcmail-total-messages ndeleted-messages)
- X pcmail-message-vector
- X (apply 'vector
- X (nreverse
- X (cons (aref pcmail-message-vector current-message)
- X new-messages)))
- X pcmail-attr-vector (apply 'vector (nreverse new-attr))
- X pcmail-summary-vector (apply 'vector (nreverse new-summary))
- X pcmail-date-vector (apply 'vector (nreverse new-date))
- X pcmail-priority-vector (apply 'vector (nreverse new-priority)))
- X (pcmail-fix-expunged-subset new-subset-map)
- X (pcmail-fix-current-message new-subset-map)
- X (pcmail-set-nmessages folder pcmail-total-messages)
- X (pcmail-change-in-folder-list folder pcmail-total-messages))
- X (or (zerop ndeleted-messages)
- X (pcmail-maybe-resummarize-folder))
- X (pcmail-goto-message pcmail-current-subset-message)))
- X (message "Expunging %s...done (%d message%s)" folder pcmail-total-messages
- X (pcmail-s-ending pcmail-total-messages)))
- X
- X(defun pcmail-expunge-loop ()
- X "Scan folder, erasing deleted messages.
- XArgs: none
- X Iterate through messages in current folder, erasing those with their
- Xdeleted attribute set. Modify inherited variables current-message,
- Xndeleted-messages, new-subset-map, new-messages, new-summary, new-date,
- Xnew-priority and new-attr. Reset message counters on quit signal."
- X (condition-case nil
- X (while (<= current-message pcmail-total-messages)
- X (cond ((pcmail-has-attribute-p current-message "deleted")
- X (and pcmail-wastebasket-on-expunge
- X (pcmail-wastebasket-message current-message 1))
- X (delete-region
- X (marker-position (aref pcmail-message-vector current-message))
- X (marker-position (aref pcmail-message-vector
- X (1+ current-message))))
- X (move-marker (aref pcmail-message-vector current-message) nil)
- X (setq ndeleted-messages (1+ ndeleted-messages))
- X (aset new-subset-map current-message nil))
- X (t
- X (aset new-subset-map current-message
- X (- current-message ndeleted-messages))
- X (setq new-messages
- X (cons (aref pcmail-message-vector current-message)
- X new-messages)
- X new-summary
- X (cons (aref pcmail-summary-vector current-message)
- X new-summary)
- X new-date
- X (cons (aref pcmail-date-vector current-message)
- X new-date)
- X new-priority
- X (cons (aref pcmail-priority-vector current-message)
- X new-priority)
- X new-attr
- X (cons (aref pcmail-attr-vector current-message)
- X new-attr))))
- X (and (zerop (% (setq current-message (1+ current-message))
- X pcmail-progress-interval))
- X (message "Expunging %s...%d" folder current-message)))
- X (quit
- X (pcmail-set-message-vectors))))
- X
- X(defun pcmail-fix-current-message (map)
- X "Adjusts the current subset message number after expunging a folder.
- XArgs: (map)
- X MAP is a vector pcmail-total-messages long, with entries that are either
- Xa message's post-expunge message number, or NIL if the message was expunged.
- XThis function decrements pcmail-current-subset-message by the number of
- XNIL entries in slots numbered less than pcmail-current-subset-message."
- X (cond ((zerop (pcmail-current-subset-length))
- X (setq pcmail-current-subset-message 0))
- X (t
- X (let ((i 0) (count 0))
- X (while (<= i pcmail-current-subset-message)
- X (or (aref map i) (setq count (1+ count)))
- X (setq i (1+ i)))
- X (setq pcmail-current-subset-message
- X (max (- pcmail-current-subset-message count) 1))))))
- X
- X(defun pcmail-get-mail (&optional folder)
- X "Open FOLDER and display its current message.
- XArgs: (&optional folder)
- X If called interactively, a prefix argument means ask for the name of a
- Xfolder to open, otherwise open the current folder. If called as a function,
- Xsupply the name of the folder to open, or NIL to open the current folder.
- XIf FOLDER has an attached mail drop, read mail from the mail drop and
- Xappend it to FOLDER. If FOLDER is already open and there us no new mail,
- Xdon't change the current message. If FOLDER is being opened for the first
- Xtime now, then after new mail has been read, go to either the last message
- Xor the first unseen and interesting message, whatever is first."
- X (interactive
- X (list (if current-prefix-arg (pcmail-read-folder "Open folder: "))))
- X (or folder
- X (setq folder pcmail-folder-name))
- X (or (pcmail-find-folder folder)
- X (error "No folder named %s." folder))
- X (let ((was-openp (pcmail-open-folder folder))
- X (newmsgs 0))
- X (unwind-protect
- X (let ((dl (pcmail-get-mail-drop-list folder)))
- X (and dl (setq newmsgs (pcmail-read-mail-drop folder dl))))
- X (if (and was-openp (zerop newmsgs))
- X (pcmail-goto-message pcmail-current-subset-message)
- X (let ((first (pcmail-next-subset-message-of-type
- X 'forward nil t
- X '(lambda (n)
- X (and (pcmail-interesting-p n)
- X (pcmail-has-attribute-p n "unseen"))))))
- X (if first
- X (pcmail-goto-message first)
- X (pcmail-last-message)))
- X (pcmail-maybe-resummarize-folder)))))
- X
- X(defun pcmail-load-mail-drop (mail-drop-sym)
- X "Load a file with a particular mail drop format into the current folder.
- XArgs: (mail-drop-sym)
- XIf called interactively, read the mail drop type symbol from the minibuffer.
- XCompletion on mail drop symbol is permitted and defaults to last mail
- Xdrop symbol supplied to this command."
- X (interactive
- X (let ((msym))
- X (setq msym
- X (intern-soft
- X (setq pcmail-last-mail-drop-type
- X (pcmail-completing-read "Load mail drop of type: "
- X obarray pcmail-last-mail-drop-type
- X '(lambda (s)
- X (get s 'conversion-function))
- X t))))
- X (list msym)))
- X (let ((folder pcmail-folder-name) (nmsgs pcmail-total-messages))
- X (or (pcmail-find-folder folder)
- X (error "No folder named %s." folder))
- X (unwind-protect
- X (pcmail-read-mail-drop folder (list mail-drop-sym))
- X (let ((first (pcmail-next-subset-message-of-type
- X 'forward nil nil
- X '(lambda (n)
- X (and (pcmail-interesting-p n)
- X (pcmail-has-attribute-p n "unseen"))))))
- X (if first
- X (pcmail-goto-message first)
- X (pcmail-last-message)))
- X (or (= nmsgs pcmail-total-messages) ;resummarize if new msgs
- X (pcmail-maybe-resummarize-folder)))))
- X
- X(defun pcmail-get-next-folder-mail ()
- X "Offer to read new mail for the next folder in the folder list.
- XArgs: none
- XLook for the first folder after this one with an attached mail drop and offer
- Xto read mail from that folder. Wrap around the folder list if necessary."
- X (interactive)
- X (let ((done) (next-folder-name pcmail-folder-name))
- X (while (not done)
- X (setq next-folder-name (pcmail-next-folder-entry next-folder-name))
- X (cond ((string= next-folder-name pcmail-folder-name)
- X (error "No other folders with mail drops"))
- X ((and
- X (save-excursion
- X (or (pcmail-folder-buffer-name next-folder-name)
- X (pcmail-open-folder next-folder-name))
- X t)
- X (pcmail-get-mail-drop-list next-folder-name)
- X (y-or-n-p (concat "Get mail from folder " next-folder-name
- X "? ")))
- X (and (y-or-n-p "Kill current folder? ")
- X (kill-buffer (current-buffer)))
- X (pcmail-get-mail next-folder-name)
- X (setq done t))))))
- X
- X;;; folder utility routines
- X
- X(defun pcmail-create-folder-file (folder mail-drop-list)
- X "Create a new folder file.
- XArgs: (folder mail-drop-list)
- X Create a folder file in pcmail-directory with name FOLDER. Place a
- Xpcmail folder Babyl header in it. If MAIL-DROP-LIST is non-NIL, put the
- Xprinted representation of each of its elts in the folder header's mail-drop:
- Xfield. Put the folder name, message count, buffer name, and mail-drop list
- Xin the folder info list. Leave buffer narrowed to Babyl header."
- X (save-excursion
- X (find-file (pcmail-folder-file-name folder))
- X (pcmail-folder-mode)
- X (let ((buffer-read-only nil))
- X (erase-buffer)
- X (pcmail-insert-babyl-header mail-drop-list))
- X (narrow-to-region (point-min) (1- (point-max)))
- X (pcmail-save-buffer)
- X (setq pcmail-folder-name folder)
- X (pcmail-add-folder-entry folder 0 (buffer-name) mail-drop-list)))
- X
- X(defun pcmail-delete-folder-file (folder)
- X "Delete a folder buffer, summary (if present), and file.
- XArgs: (folder)
- X Delete FOLDER's file, and kill its corresponding folder and summary
- Xbuffers if they exist. Remove FOLDER's name from folder info list."
- X (and (file-exists-p (pcmail-folder-file-name folder))
- X (condition-case nil
- X (delete-file (pcmail-folder-file-name folder))
- X (file-error nil)))
- X (let ((buf (pcmail-folder-buffer-name folder)))
- X (and buf
- X (get-buffer buf)
- X (save-excursion
- X (set-buffer buf)
- X (and pcmail-summary-buffer
- X (get-buffer pcmail-summary-buffer)
- X (kill-buffer pcmail-summary-buffer))
- X (set-buffer-modified-p nil)
- X (kill-buffer buf))))
- X (pcmail-remove-folder-entry folder))
- X
- X(defun pcmail-maybe-resummarize-folder ()
- X "If pcmail-resummarize-folder is non-NIL, resummarize the current folder.
- XArgs: (none)"
- X (cond ((and pcmail-resummarize-folder-on-change
- X pcmail-summary-buffer)
- X (pcmail-summarize-folder)
- X (pop-to-buffer pcmail-summary-owner))))
- X
- X(defun pcmail-barf-if-empty-folder ()
- X "Barf if a folder is empty.
- XArgs: none
- X Signal an error if the current folder's current subset is zero-length.
- XSet message counters first, if necessary."
- X (pcmail-maybe-set-message-vectors)
- X (cond ((zerop pcmail-total-messages)
- X (pcmail-display-subset-message 0)
- X (error "%s is empty!" pcmail-folder-name))
- X ((zerop (pcmail-current-subset-length))
- X (pcmail-display-subset-message 0)
- X (error "Current message subset is empty!"))))
- X
- X(defun pcmail-read-folder (prompt)
- X "Read a folder name form the minibuffer
- XArgs: (prompt)
- X Provide PROMPT, then read a folder name from the minibuffer, completing
- Xoff of folder info list. If pcmail-last-folder is non-NIL, use it as
- Xa default. Set pcmail-last-folder to input value. See
- Xpcmail-completing-read."
- X (or (pcmail-find-folder pcmail-last-folder)
- X (setq pcmail-last-folder nil))
- X (let ((in))
- X (while (not (pcmail-legal-folder-name-p
- X (setq in (pcmail-completing-read
- X prompt obarray pcmail-last-folder
- X '(lambda (s) (get s 'folder-name)))))))
- X (setq pcmail-last-folder in)))
- X
- X(defun pcmail-legal-folder-name-p (s)
- X "Is specified string a legal Pcmail folder name?
- XArgs: (s)
- X Return t if S is a legal folder name, NIL else. A legal folder name
- Xsatisfies the regexp pcmail-folder-regexp, which is operating-system
- Xdependent."
- X (and (string-match pcmail-folder-regexp s)
- X (= (length (substring s (match-beginning 0) (match-end 0)))
- X (length s))))
- X
- X(defun pcmail-load-folder-information ()
- X "Open the folder list file and construct information for each folder
- XArgs: none
- X Using the folder list file, add information for each folder. The
- Xinformation consists of folder name, buffer name, number of messages,
- Xand mail drop list."
- X (let ((mbname))
- X (save-excursion
- X (pcmail-open-folder-list)
- X (goto-char (point-min))
- X (while (re-search-forward pcmail-folder-line-regexp nil t)
- X (setq mbname (buffer-substring (match-beginning 1) (match-end 1)))
- X (cond ((not (pcmail-find-folder mbname))
- X (pcmail-set-folder-name mbname mbname)
- X (pcmail-set-nmessages mbname
- X (string-to-int (buffer-substring
- X (match-beginning 2)
- X (match-end 2))))))))
- X (bury-buffer pcmail-folder-list)))
- X
- X(defun pcmail-add-folder-entry (folder nmsgs buf droplist)
- X "Add a folder entry; give it a name, count, buffer, and drop list.
- XArgs: (folder nmsgs buf droplist)"
- X (pcmail-set-folder-name folder folder)
- X (pcmail-set-nmessages folder nmsgs)
- X (pcmail-set-folder-buffer-name folder buf)
- X (pcmail-set-mail-drop-list folder droplist))
- X
- X(defun pcmail-remove-folder-entry (folder)
- X "Remove a folder entry by setting its name to NIL.
- XArgs: (folder)"
- X (pcmail-set-folder-name folder nil))
- X
- X(defun pcmail-get-mail-drop-list (folder-name)
- X "Get this folder's mail-drop list. Assume folder is current buffer.
- XArgs: folder-name
- X If folder has not yet been opened (i.e. buffer name is nil), read list
- Xfrom mail: field of folder file header, turn it into a lisp list, and return."
- X (cond ((not (pcmail-folder-buffer-name folder-name))
- X (pcmail-get-babyl-mail-drop-list))
- X (t
- X (pcmail-mail-drop-list folder-name))))
- X
- X(defun pcmail-open-folder (folder-name)
- X "Find specified folder's folder file and place it in pcmail mode.
- X Args: (folder-name)
- XFind FOLDER-NAME's folder file. If it did not exist before finding,
- Xplace it in pcmail mode. Replace old buffer value in folder info list
- Xwith current buffer name. Set the folder's message counters if necessary.
- XLoad the folder's user-defined attributes into the attribute completion
- Xobarray. Turn folder's mail drops (as specified in the folder's mail-drop:
- Xfield) into a list and add to folder entry in info list. Return T if
- XFOLDER-NAME's folder file was already open, NIL else."
- X (let* ((file-name (pcmail-folder-file-name folder-name))
- X (existed (get-file-buffer file-name)))
- X (or (pcmail-find-folder folder-name)
- X (error "%s is not a Pcmail folder." folder-name))
- X (find-file file-name)
- X (cond ((not existed)
- X (pcmail-folder-mode)
- X (setq pcmail-folder-name folder-name)
- X (pcmail-set-mail-drop-list folder-name
- X (pcmail-get-mail-drop-list folder-name))
- X (pcmail-set-folder-buffer-name folder-name (buffer-name))
- X (pcmail-load-user-defined-attributes)))
- X
- X ;require-final-newline hosed us? Punt trailing whitespace but don't
- X ; change buffer-modified-p
- X (save-excursion
- X (save-restriction
- X (widen)
- X (goto-char (point-max))
- X (skip-chars-backward " \t\n")
- X (let ((buffer-read-only nil)
- X (modp (buffer-modified-p)))
- X (delete-region (point) (point-max))
- X (set-buffer-modified-p modp))))
- X (pcmail-maybe-set-message-vectors)
- X existed))
- X
- X(defun pcmail-folder-file-name (folder-name)
- X "Expand FOLDER-NAME into an absolute path, translating it as necessary
- Xif it contains characters that are illegal file name characters."
- X (expand-file-name (funcall (get 'pcmail-mail-environment
- X 'folder-to-file-function) folder-name)
- X pcmail-directory))
- X
- X;;; the following functions are the only ones which know about the storage
- X;;; and access method for folder information. Current method is a folder
- X;;; symbol for each folder, with properties containing number of messages,
- X;;; buffer name, and mail drop list
- X
- X(defun pcmail-all-folders (&optional fun)
- X "Return a list of all valid folder names.
- XArgs: &optional fun
- XIf FUN is present, use it as the completion filter, otherwise use a filter
- Xthat will return all folder names"
- X (all-completions "" obarray (or fun '(lambda (s) (get s 'folder-name)))))
- X
- X(defun pcmail-find-folder (folder-name)
- X "Return non-NIL if specified folder exists, NIL else.
- XArgs: (folder-name)
- X Search folder info list for an entry associated with FOLDER-NAME,
- Xreturning the entry if it exists, NIL else."
- X (and (stringp folder-name)
- X (setq folder-name (intern-soft folder-name))
- X (get folder-name 'folder-name)
- X folder-name))
- X
- X(defun pcmail-set-folder-name (folder-name name)
- X "Set FOLDER-NAME's symbol's 'folder-name property to NAME
- XArgs: (folder-name name).
- X Note that FOLDER-NAME need not be a valid folder name, since the test
- Xfor validity will fail until this routine is called to insert a valid name."
- X (put (intern folder-name) 'folder-name name))
- X
- X(defun pcmail-set-folder-buffer-name (folder-name bname)
- X "Set FOLDER-NAME's symbol's 'folder-buffer-name property to BNAME
- XArgs: (folder-name bname)."
- X (put (pcmail-find-folder folder-name) 'folder-buffer-name bname))
- X
- X(defun pcmail-set-mail-drop-list (folder-name droplist)
- X "Set FOLDER-NAME's symbol's 'mail-drop-list property to DROPLIST
- XArgs: (folder-name droplist)."
- X (put (pcmail-find-folder folder-name) 'mail-drop-list droplist))
- X
- X(defun pcmail-set-nmessages (folder-name nmsgs)
- X "Set FOLDER-NAME's symbol's 'nmessages property to NMSGS
- XArgs: (folder-name nmsgs)."
- X (put (pcmail-find-folder folder-name) 'nmessages nmsgs))
- X
- X(defun pcmail-nmessages (folder-name)
- X "Return the number of messages contained in the specified folder.
- XArgs: (folder-name)"
- X (and (setq folder-name (pcmail-find-folder folder-name))
- X (get folder-name 'nmessages)))
- X
- X(defun pcmail-mail-drop-list (folder-name)
- X "Return the mail drop list attached to the specified folder.
- XArgs: (folder-name)"
- X (and (setq folder-name (pcmail-find-folder folder-name))
- X (get folder-name 'mail-drop-list)))
- X
- X(defun pcmail-folder-buffer-name (folder-name)
- X "Return the buffer name associated with the specified folder.
- XArgs: (folder-name)"
- X (and (setq folder-name (pcmail-find-folder folder-name))
- X (get folder-name 'folder-buffer-name)))
- X
- X(provide 'pcmailfolder)
- ________This_Is_The_END________
- if test `wc -c < pcmailfolder.el` -ne 30814; then
- echo 'shar: pcmailfolder.el was damaged during transit (should have been 30814 bytes)'
- fi
- fi ; : end of overwriting check
- echo 'x - pcmaillist.el'
- if test -f pcmaillist.el; then echo 'shar: not overwriting pcmaillist.el'; else
- sed 's/^X//' << '________This_Is_The_END________' > pcmaillist.el
- X;;;; GNU-EMACS PCMAIL mail reader
- X
- X;; Written by Mark L. Lambert
- X;; Architecture Group, Network Products Division
- X;; Oracle Corporation
- X;; 20 Davis Dr,
- X;; Belmont CA, 94002
- X;;
- X;; internet: markl@oracle.com or markl%oracle.com@apple.com
- X;; UUCP: {hplabs,uunet,apple}!oracle!markl
- X
- X;; Copyright (C) 1989 Mark L. Lambert
- X
- X;; This file is not officially part of GNU Emacs, but is being
- X;; donated to the Free Software Foundation. As such, it is
- X;; subject to the standard GNU-Emacs General Public License,
- X;; referred to below.
- X
- X;; GNU Emacs is distributed in the hope that it will be useful,
- X;; but WITHOUT ANY WARRANTY. No author or distributor
- X;; accepts responsibility to anyone for the consequences of using it
- X;; or for whether it serves any particular purpose or works at all,
- X;; unless he says so in writing. Refer to the GNU Emacs General Public
- X;; License for full details.
- X
- X;; Everyone is granted permission to copy, modify and redistribute
- X;; GNU Emacs, but only under the conditions described in the
- X;; GNU Emacs General Public License. A copy of this license is
- X;; supposed to have been given to you along with GNU Emacs so you
- X;; can know your rights and responsibilities. It should be in a
- X;; file named COPYING. Among other things, the copyright notice
- X;; and this notice must be preserved on all copies.
- X
- X
- X;;;; folder list commands and utilities
- X
- X;;;; global variables
- X
- X;;; system-defined globals
- X
- X(defconst pcmail-folder-list "folders"
- X "The file under pcmail-directory that contains the pcmail folder list.")
- X
- X(defvar pcmail-folder-list-mode-map nil
- X "Key map for pcmail-folder-list mode.")
- X
- X;;;; key map and definitions
- X
- X(if pcmail-folder-list-mode-map
- X nil
- X (suppress-keymap (setq pcmail-folder-list-mode-map (make-keymap)))
- X (define-key pcmail-folder-list-mode-map "."
- X 'pcmail-folder-list-beginning-of-message)
- X (define-key pcmail-folder-list-mode-map "?" 'describe-mode)
- X (define-key pcmail-folder-list-mode-map "c" 'pcmail-create-folder)
- X (define-key pcmail-folder-list-mode-map "d"
- X 'pcmail-folder-list-delete-folder)
- X (define-key pcmail-folder-list-mode-map "e"
- X 'pcmail-folder-list-expunge-folder)
- X (define-key pcmail-folder-list-mode-map "g" 'pcmail-folder-list-get-mail)
- X (define-key pcmail-folder-list-mode-map "h"
- X 'pcmail-folder-list-summarize-folder)
- X (define-key pcmail-folder-list-mode-map "i" 'pcmail-folder-list-get-mail)
- X (define-key pcmail-folder-list-mode-map "q" 'pcmail-quit)
- X (define-key pcmail-folder-list-mode-map "r"
- X 'pcmail-folder-list-rename-folder)
- X (define-key pcmail-folder-list-mode-map "s" 'pcmail-folder-list-save-folder)
- X (define-key pcmail-folder-list-mode-map "x" 'pcmail-folder-list-exit))
- X
- X;;; pcmail-folder-list mode -- used in folder list buffer
- X
- X(defun pcmail-folder-list-mode ()
- X "Pcmail Folder List Mode is used by \\[pcmail] for manipulating Pcmail
- Xfolders. The following commands are available:
- X\\{pcmail-folder-list-mode-map}"
- X (interactive)
- X (pcmail-mode-setup 'pcmail-folder-list-mode "Folder List"
- X pcmail-folder-list-mode-map)
- X (let ((fill-pre (cond (mode-line-inverse-video "") (t "-----")))
- X (fill-post (cond (mode-line-inverse-video " ") (t "%-"))))
- X (setq mode-line-format (list fill-pre "Folder List "
- X 'global-mode-string fill-post)))
- X (run-hooks 'pcmail-folder-list-mode-hook))
- X
- X;;;; folder-list mode commands
- X
- X(defun pcmail-folder-list-folders ()
- X "Open and display the folder list file in the other window.
- XArgs: none"
- X (interactive)
- X (let ((b))
- X (save-excursion
- X (pcmail-open-folder-list)
- X (setq b (current-buffer)))
- X (pop-to-buffer b)
- X (goto-char (point-min))))
- X
- X(defun pcmail-folder-list-exit ()
- X "Exit the folder list, returning to the current folder.
- XArgs: none"
- X (interactive)
- X (pop-to-buffer (or (and (pcmail-folder-buffer-name (pcmail-folder-at-point))
- X (get-buffer (pcmail-folder-buffer-name
- X (pcmail-folder-at-point))))
- X (pcmail-folder-buffer-name pcmail-primary-folder-name)))
- X (delete-other-windows))
- X
- X(defun pcmail-folder-list-beginning-of-message ()
- X "Display the current message in the folder next to the cursor.
- XArgs: none"
- X (interactive)
- X (let ((mb (or (pcmail-folder-at-point) (error "No current folder."))))
- X (other-window 1)
- X (pcmail-open-folder mb)
- X (pcmail-beginning-of-message)))
- X
- X(defun pcmail-folder-list-rename-folder ()
- X "Change the name of the next to the cursor. See pcmail-rename-folder-1.
- XArgs: none"
- X (interactive)
- X (let ((mb (or (pcmail-folder-at-point) (error "No current folder."))))
- X (other-window 1)
- X (pcmail-rename-folder mb (pcmail-read-folder "Rename to new name: "))))
- X
- X(defun pcmail-folder-list-delete-folder ()
- X "Delete the folder next to the cursor. See pcmail-delete-folder.
- XArgs: none"
- X (interactive)
- X (let ((mb (or (pcmail-folder-at-point) (error "No current folder."))))
- X (other-window 1)
- X (pcmail-delete-folder mb)))
- X
- X(defun pcmail-folder-list-save-folder ()
- X "Save the folder next to the cursor. See pcmail-save-folder.
- XArgs: none"
- X (interactive)
- X (let ((mb (or (pcmail-folder-at-point) (error "No current folder."))))
- X (other-window 1)
- X (pcmail-save-folder mb)))
- X
- X(defun pcmail-folder-list-summarize-folder ()
- X "Summarize the folder next to the cursor. See pcmail-summarize-folder.
- XArgs: none"
- X (interactive)
- X (let ((mb (or (pcmail-folder-at-point) (error "No current folder."))))
- X (other-window 1)
- X (pcmail-summarize-folder mb)))
- X
- X(defun pcmail-folder-list-expunge-folder ()
- X "Expunge the folder next to the cursor. See pcmail-expunge-1.
- XArgs: none"
- X (interactive)
- X (let ((mb (or (pcmail-folder-at-point) (error "No current folder."))))
- X (other-window 1)
- X (pcmail-expunge-folder mb)))
- X
- X(defun pcmail-folder-list-get-mail ()
- X "Open the folder next to the cursor and transfer any new mail into it.
- XArgs: none
- X Open the current folder. If the folder has an attached mail drop list,
- Xtransfer mail from the mail drops into the folder. See pcmail-get-mail."
- X (interactive)
- X (let ((mb (or (pcmail-folder-at-point) (error "No current folder."))))
- X (other-window 1)
- X (pcmail-get-mail mb)))
- X
- X;;; folder list utility routines
- X
- X(defun pcmail-create-folder-list-file ()
- X "Create a folder list file in the mail directory
- XArgs: none"
- X (pcmail-open-folder-list)
- X (set-buffer-modified-p t)
- X (pcmail-save-buffer))
- X
- X(defun pcmail-open-folder-list ()
- X "Find and display the folder list file in pcmail-folder-list mode.
- XArgs: none"
- X (let ((existed (get-buffer pcmail-folder-list)))
- X (find-file (expand-file-name pcmail-folder-list pcmail-directory))
- X (or existed
- X (pcmail-folder-list-mode))))
- X
- X(defun pcmail-folder-at-point ()
- X "Return name of folder where cursor is in folder list buffer.
- XArgs: none
- X Jump to folder list buffer pcmail-folder-list and return the name of the
- Xfolder on the buffer's current line. Return NIL if the buffer is empty,
- Ximproperly formatted, or if no folder exists on the current line."
- X (and (get-buffer pcmail-folder-list)
- X (save-excursion
- X (set-buffer pcmail-folder-list)
- X (save-excursion
- X (end-of-line)
- X (and (re-search-forward pcmail-folder-line-regexp
- X (prog1 (point) (beginning-of-line)) t)
- X (buffer-substring (match-beginning 1) (match-end 1)))))))
- X
- X(defun pcmail-next-folder-entry (folder-name)
- X "Return the name of the folder following FOLDER-NAME in the folder list.
- XArgs: (folder-list)"
- X (let ((nextname))
- X (and (pcmail-find-folder folder-name)
- X (save-excursion
- X (pcmail-open-folder-list)
- X (goto-char (point-min))
- X (re-search-forward (concat "^folder " folder-name ":.*\n") nil t)
- X (and (eq (point) (point-max)) ;wrap if at end of buffer
- X (goto-char (point-min)))
- X (setq nextname (pcmail-folder-at-point))))
- X (bury-buffer pcmail-folder-list)
- X nextname))
- X
- X(defun pcmail-change-in-folder-list (folder-name nmessages)
- X "Update a specified folder's entry in the folder list buffer.
- XArgs: (folder-name nmessages)"
- X (save-excursion
- X (pcmail-open-folder-list)
- X (let ((buffer-read-only nil))
- X (goto-char (point-min))
- X (and (re-search-forward (format "Folder %s:.*\n" folder-name) nil t)
- X (replace-match (format "Folder %s: %d message%s\n" folder-name
- X nmessages (pcmail-s-ending nmessages))))))
- X (bury-buffer pcmail-folder-list)
- X (pcmail-save-buffer pcmail-folder-list))
- X
- X(defun pcmail-insert-into-folder-list (folder-name nmessages)
- X "Add a new folder line to the folder list buffer.
- XArgs: (folder-name nmessages)
- X Open the folder list file, go to the end of the buffer, and append an
- Xentry for FOLDER-NAME with a message count of NMESSAGES. Save and bury
- Xthe list buffer after insertion."
- X (save-excursion
- X (pcmail-open-folder-list)
- X (let ((buffer-read-only nil))
- X (goto-char (point-max))
- X (or (= (buffer-size) 0) ;add newline if already text in the
- X (eq (preceding-char) ?\n) ;buffer with no trailing newline
- X (insert ?\n))
- X (insert "Folder " folder-name ": " (int-to-string nmessages)
- X " message" (pcmail-s-ending nmessages) "\n")))
- X (bury-buffer pcmail-folder-list))
- X
- X(defun pcmail-remove-from-folder-list (folder-name)
- X "Remove a specified folder's entry from the folder list buffer.
- XArgs: (folder-name)"
- X (save-excursion
- X (pcmail-open-folder-list)
- X (let ((buffer-read-only nil))
- X (goto-char (point-min))
- X (cond ((re-search-forward (format "Folder %s:" folder-name) nil t)
- X (beginning-of-line)
- X (delete-region (point) (progn (forward-line 1) (point)))))))
- X (bury-buffer pcmail-folder-list))
- X
- X(provide 'pcmaillist)
- ________This_Is_The_END________
- if test `wc -c < pcmaillist.el` -ne 9542; then
- echo 'shar: pcmaillist.el was damaged during transit (should have been 9542 bytes)'
- fi
- fi ; : end of overwriting check
- exit 0
-
-